home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / arith2.com / FIX_MOD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-27  |  6.8 KB  |  203 lines
  1. UNIT fix_mod;
  2.  
  3. {$O+}
  4.  
  5.         { ------------------------------------------------------------------
  6.  
  7.           This program and its associates implement in Turbo Pascal v5
  8.           the aritmetic encoding/decoding algorithms presented in the papers
  9.  
  10.           "Arithmetic Coding for Data Compression"
  11.  
  12.                    by Ian     H. Witten
  13.                       Radford M. Neal
  14.                       John    G. Cleary
  15.  
  16.           pp 520 - 540 of June 1987 Communications of the ACM
  17.  
  18.           and
  19.  
  20.           "An Adaptive Dependency Source Model For Data Compression"
  21.  
  22.                    by David M. Abrahamson
  23.  
  24.           pp 77 - 83 of January 1989 Communications of the ACM
  25.  
  26.           ------------------------------------------------------------------
  27.  
  28.           Implemented by Ken Westerback : CompuServe 73547,3520
  29.  
  30.           version 1.0 released 89/02/19
  31.           version 2.0 released 89/02/27
  32.  
  33.           These programs, units and associated documentation are released
  34.           into the public domain to be used and abused as your whims
  35.           dictate.
  36.  
  37.           Feel free to distribute/incorporate/improve as desired.
  38.  
  39.           >>>>> Use at your own risk! <<<<<
  40.  
  41.           Comments and suggestions welcome via CompuServe.
  42.  
  43.           ------------------------------------------------------------------
  44.         }
  45.  
  46.  
  47. INTERFACE
  48.  
  49.  
  50. const model_name = 'Fixed Model';
  51.  
  52. { this procedure initializes the model - must be exported cuz we }
  53. { may be overlay'ed                                              }
  54.  
  55. procedure start_model;
  56.  
  57. function  select_char   ( symbol : integer ) : char;
  58.  
  59. function  select_symbol (     ch : char    ) : integer;
  60.  
  61. procedure update_model  ( symbol : integer );
  62.  
  63.  
  64. IMPLEMENTATION uses model_h;
  65.  
  66.  
  67. { make these arrays dynamic so multiple model overlays will not }
  68. { use up unnecessary memory, or worse, use the same memory for  }
  69. { different things!                                             }
  70.  
  71. type ctoi_array = array [ 0..no_of_chars-1 ] of integer;
  72.      itoc_array = array [ 0..no_of_symbols ] of char;
  73.  
  74.      ctoi_p = ^ctoi_array;
  75.      itoc_p = ^itoc_array;
  76.  
  77.  
  78. var char_to_index : ctoi_p; { to index from character }
  79.     index_to_char : itoc_p; { to character from index }
  80.  
  81.  
  82. procedure start_model;
  83.  
  84.           var i : integer;
  85.  
  86.           begin
  87.  
  88.           new ( index_to_char );
  89.           new ( char_to_index );
  90.  
  91.           { set up frequency table to constant values }
  92.  
  93.           freq[ 0 ] := 0;
  94.           for i := 1 to no_of_symbols do
  95.              freq[ i ] := 1;
  96.  
  97.           { a typed constant would work here, but this method makes }
  98.           { this model compatible with all others                   }
  99.           { all characters not explicitly mentioned here are left   }
  100.           { with a frequency of 1 from the previous loop            }
  101.  
  102.           freq[ ord( 'A' )+1 ] := 24;  freq[ ord( 'a' )+1 ] := 491;
  103.           freq[ ord( 'B' )+1 ] := 15;  freq[ ord( 'b' )+1 ] :=  85;
  104.           freq[ ord( 'C' )+1 ] := 22;  freq[ ord( 'c' )+1 ] := 173;
  105.           freq[ ord( 'D' )+1 ] := 12;  freq[ ord( 'd' )+1 ] := 232;
  106.           freq[ ord( 'E' )+1 ] := 15;  freq[ ord( 'e' )+1 ] := 744;
  107.           freq[ ord( 'F' )+1 ] := 10;  freq[ ord( 'f' )+1 ] := 127;
  108.           freq[ ord( 'G' )+1 ] :=  9;  freq[ ord( 'g' )+1 ] := 110;
  109.           freq[ ord( 'H' )+1 ] := 16;  freq[ ord( 'h' )+1 ] := 293;
  110.           freq[ ord( 'I' )+1 ] := 16;  freq[ ord( 'i' )+1 ] := 418;
  111.           freq[ ord( 'J' )+1 ] :=  8;  freq[ ord( 'j' )+1 ] :=   6;
  112.           freq[ ord( 'K' )+1 ] :=  6;  freq[ ord( 'k' )+1 ] :=  39;
  113.           freq[ ord( 'L' )+1 ] := 12;  freq[ ord( 'l' )+1 ] := 250;
  114.           freq[ ord( 'M' )+1 ] := 23;  freq[ ord( 'm' )+1 ] := 139;
  115.           freq[ ord( 'N' )+1 ] := 13;  freq[ ord( 'n' )+1 ] := 429;
  116.           freq[ ord( 'O' )+1 ] := 11;  freq[ ord( 'o' )+1 ] := 446;
  117.           freq[ ord( 'P' )+1 ] := 14;  freq[ ord( 'p' )+1 ] := 111;
  118.           freq[ ord( 'Q' )+1 ] :=  1;  freq[ ord( 'q' )+1 ] :=   5;
  119.           freq[ ord( 'R' )+1 ] := 14;  freq[ ord( 'r' )+1 ] := 388;
  120.           freq[ ord( 'S' )+1 ] := 28;  freq[ ord( 's' )+1 ] := 375;
  121.           freq[ ord( 'T' )+1 ] := 29;  freq[ ord( 't' )+1 ] := 531;
  122.           freq[ ord( 'U' )+1 ] :=  6;  freq[ ord( 'u' )+1 ] := 152;
  123.           freq[ ord( 'V' )+1 ] :=  3;  freq[ ord( 'v' )+1 ] :=  57;
  124.           freq[ ord( 'W' )+1 ] := 11;  freq[ ord( 'w' )+1 ] :=  97;
  125.           freq[ ord( 'X' )+1 ] :=  1;  freq[ ord( 'x' )+1 ] :=  12;
  126.           freq[ ord( 'Y' )+1 ] :=  3;  freq[ ord( 'y' )+1 ] := 101;
  127.           freq[ ord( 'Z' )+1 ] :=  1;  freq[ ord( 'z' )+1 ] :=   5;
  128.  
  129.           freq[ ord( '0' )+1 ] := 15;  freq[ ord( '1' )+1 ] := 15;
  130.           freq[ ord( '2' )+1 ] :=  8;  freq[ ord( '3' )+1 ] :=  5;
  131.           freq[ ord( '4' )+1 ] :=  4;  freq[ ord( '5' )+1 ] :=  7;
  132.           freq[ ord( '6' )+1 ] :=  5;  freq[ ord( '7' )+1 ] :=  4;
  133.           freq[ ord( '8' )+1 ] :=  4;  freq[ ord( '9' )+1 ] :=  6;
  134.  
  135.           freq[ ord( ' ' )+1 ] := 1236;  freq[ ord( ';' )+1 ] :=    2;
  136.           freq[ ord( '"' )+1 ] :=   21;  freq[ ord( '.' )+1 ] := 60;
  137.           freq[ ord( '#' )+1 ] :=    9;  freq[ ord( '-' )+1 ] := 19;
  138.           freq[ ord( '$' )+1 ] :=    3;  freq[ ord( '*' )+1 ] :=  2;
  139.           freq[ ord( '&' )+1 ] :=   25;  freq[ ord( ',' )+1 ] := 79;
  140.           freq[ ord( '{' )+1 ] :=    2;  freq[ ord( '}' )+1 ] :=  2;
  141.           freq[ ord( '(' )+1 ] :=    2;  freq[ ord( ')' )+1 ] :=  2;
  142.           freq[ ord( '"' )+1 ] :=   21;  freq[ ord( '*' )+1 ] :=  2;
  143.           freq[ ord( ':' )+1 ] :=    3;  freq[ ord( '~' )+1 ] :=  3;
  144.  
  145.           freq[ ord( '''' )+1 ] := 15;
  146.  
  147.           freq[ 11 ] := 124;
  148.  
  149.           { set up tables that translate between symbol indexes and characters }
  150.  
  151.           for i := 0 to no_of_chars - 1 do
  152.               begin
  153.               char_to_index^[ i   ] := i+1;
  154.               index_to_char^[ i+1 ] := chr ( i );
  155.               end;
  156.  
  157.           { set up cumulative frequency counts }
  158.  
  159.           cum_freq[ no_of_symbols ] := 0;
  160.  
  161.           for i := no_of_symbols downto 1 do
  162.               cum_freq[ i-1 ] := cum_freq[ i ] + freq[ i ];
  163.  
  164.           { check that counts are within the limit }
  165.  
  166.           if ( cum_freq[ 0 ] > max_frequency ) then
  167.              begin
  168.              writeln ;
  169.              writeln ( 'fixed : cumulative frequence exceeds max_frequency' );
  170.              writeln ;
  171.              halt;
  172.              end;
  173.  
  174.           end;
  175.  
  176. function select_symbol;
  177.  
  178.          begin
  179.  
  180.          select_symbol := char_to_index^[  ord( ch ) ];
  181.  
  182.          end; { select symbol }
  183.  
  184.  
  185. function select_char;
  186.  
  187.          begin
  188.  
  189.          select_char := index_to_char^[ symbol ];
  190.  
  191.          end; { select_char }
  192.  
  193.  
  194. procedure update_model;
  195.           begin
  196.  
  197.           { this being a fixed model, we need do nothing! }
  198.  
  199.           end { update model };
  200.  
  201.  
  202. END. { fixed model implementation }
  203.